home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / browserMode.tcl < prev    next >
Encoding:
Text File  |  1997-12-10  |  4.2 KB  |  149 lines  |  [TEXT/ALFA]
  1. #=============================================================================
  2. # Browser mode.
  3. # 
  4. # Alpha cannot do batch searches without this file
  5. #=============================================================================
  6.  
  7. alpha::mode Brws 1.0 dummyBrws 
  8.  
  9. bind '\r'        gotoMatch    Brws
  10. bind enter        gotoMatch    Brws
  11. ascii 0x3          gotoMatch   Brws
  12. bind down         downBrowse Brws
  13. bind up         upBrowse Brws
  14. bind 'n' <z>    downBrowse Brws
  15. bind 'p' <z>    upBrowse Brws
  16. ascii 0x20        downBrowse Brws
  17. ascii 0x8        upBrowse Brws
  18. # this was below.  do we need it?
  19. bind 'c' <Cz>        gotoMatch
  20.  
  21. proc dummyBrws {} {}
  22.  
  23. proc upBrowse {} {
  24.     set limit [nextLineStart [nextLineStart 0]]
  25.     if {[getPos] > $limit} {
  26.         set limit [expr [getPos] - 1]
  27.     }
  28.     select [lineStart $limit] [nextLineStart $limit]
  29. }
  30.  
  31. proc downBrowse {} {
  32.     set pos [getPos]
  33.     if {$pos < [nextLineStart 0]} {
  34.         set pos [nextLineStart 0]
  35.     }
  36.     if {[nextLineStart $pos] != [maxPos]} {
  37.         select [nextLineStart $pos] [nextLineStart [nextLineStart $pos]]
  38.     }
  39. }
  40.  
  41. proc nextMatch {{wname "*Batch Find*"}} {
  42.     set wins [winNames]
  43.     set res [lsearch $wins $wname]
  44.     if {$res < 0} {
  45.         set res [lsearch -regexp $wins {\*.*\*}]
  46.         if {$res < 0} return
  47.     }
  48.     set win [lindex $wins $res]
  49.     bringToFront $win
  50.     downBrowse
  51.     gotoMatch
  52.     dispErr $win
  53. }
  54.  
  55. proc dispErr {{win "* Compiler Errors *"}} {
  56.     if {[string length $win]} {
  57.         set text [getText -w $win [getPos -w $win] [selEnd -w $win]]
  58.         if {[regexp {(Line.*)∞} $text dummy sub]} {
  59.             message "$sub"
  60.         }
  61.     }
  62. }
  63.         
  64.  
  65. ##############################################################################
  66. #  To be used in the windows created by "matchingLines" or by batch searches.
  67. #
  68. #  With the cursor positioned in a line corrsponding to a match, 
  69. #  go back and select the line in the original file that 
  70. #  generated this match.  (Like emacs 'Occur' functionality)
  71. #
  72. #  97-08-01 Now doesn't ask if you want a new copy of windows with <n>.
  73. #           Wrap dialog also skipped.
  74. proc gotoMatch {} {
  75.     if {[string match "*MAILBOX*" [win::CurrentTail]]} {
  76.         mailGotoMatch
  77.         return
  78.     }
  79.     global tileHeight tileWidth tileTop tileLeft tileHeight errorHeight errorDisp tileMargin
  80.     set text [getText [lineStart [getPos]] [expr [nextLineStart [getPos]] - 1]]
  81.     set ind1 [string first "∞" $text]
  82.     set ind2 [string last "∞" $text]
  83.     if {$ind1 == $ind2} {
  84.         set fname [string trim [string range $text $ind1 end] {∞}]
  85.         set msg ""
  86.     } else {
  87.         set fname [string trim [string range $text $ind1 $ind2] {∞}]
  88.         set msg [string trim [string range $text $ind2 end] {∞}]
  89.     }
  90.     
  91.     set top $tileTop
  92.     set geo [getGeometry]
  93.     if {([lindex $geo 0] != $tileLeft) || ([lindex $geo 1] != $top) || ([lindex $geo 3] != $errorHeight) } {
  94.         moveWin $tileLeft $top
  95.         sizeWin $tileWidth $errorHeight
  96.     }
  97.     set mar $tileMargin
  98.     incr top [expr $errorHeight + $mar]
  99.     if {[file exists $fname]} {
  100.         edit -c -w -g $tileLeft $top $tileWidth $errorDisp $fname
  101.         set geo [getGeometry]
  102.         if {([lindex $geo 0] != $tileLeft) || ([lindex $geo 1] != $top) || ([lindex $geo 2] != $tileWidth) || ([lindex $geo 3] != $errorDisp) } {
  103.             sizeWin $tileWidth $errorDisp
  104.             moveWin $tileLeft $top
  105.         }
  106.     } else {
  107.         if {![string match "*Link*" [getText 0 [nextLineStart 0]]]} {
  108.             alertnote "File \" $fname \" not found." 
  109.         }
  110.         return
  111.     }
  112.     if {[regexp {Line ([0-9]+):} $text dummy line]} {
  113.         set pos [rowColToPos $line 0]
  114.         select $pos [nextLineStart $pos]
  115.     }
  116.     message $msg
  117. }
  118.  
  119. set lastMatchingLines ""
  120.  
  121. proc matchingLines {{reg ""} {for 1} {ign 1} {word 0} {regexp 1}} {
  122.     global lastMatchingLines
  123.     
  124.     if {![string length $reg] && [catch {prompt "Regular expression:" $lastMatchingLines} reg]} return
  125.     set lastMatchingLines $reg
  126.     if {![string length $reg]} return
  127.     if {!$regexp} {
  128.         set reg [quote::Regfind $reg]
  129.     }
  130.     if $word {
  131.         set reg "^.*\\b$reg\\b.*$"
  132.     } else {
  133.         set reg "^.*$reg.*$"
  134.     }
  135.     set pos [expr $for ? 0 : [getPos]]
  136.     set fileName [win::Current]
  137.     set matches 0
  138.     set lines {}
  139.     while {![catch {search -s -f 1 -r 1 -i $ign $reg $pos} mtch]} {
  140.         append lines "\r" [format "Line %d: " [lindex [posToRowCol [lindex $mtch 0]] 0]] [eval getText $mtch] "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fileName"
  141.         set pos [lindex $mtch 1]
  142.         incr matches
  143.     }
  144.     grepsToWindow {* Matching Lines *} \
  145.         [format "%d matching lines (<cr> to go to match)\r-----" $matches] \
  146.         $lines "\r"
  147. }
  148.  
  149.